Sky at Night 2006 September/SAN CD 9-2006 CD-ROM 16.iso/pc/Software/Network Telescope Control/NTC-Setup.Exe/Source/ntc_client_network.pas

Pascal/Delphi Source File | 2006-03-24 | 19.3 KB | 932 lines

unit ntc_client_network;
{
    Copyright (C) 2004 - 2006 Andrew Sprott

    http://astronomy.crysania.co.uk
    [e-mail]

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}

interface

uses
    Windows,
    Messages,
    SysUtils,
    Variants,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    StdCtrls,
    Mask,
    Buttons,
    ExtCtrls,
    inifiles,

    IdBaseComponent,
    IdComponent,
    IdTCPConnection,
    IdTCPClient,
    idglobal,

    ntc_client_form;

const
    { timeout intervals }
    response_timeout=2000;
    read_timeout=IdTimeoutInfinite;
    read_fail_count=2000;
    connect_timeout=1500;
    max_buffer_size=240;
    crlf=chr(13)+chr(10);

type
    response_type_set=(
        exit_ok,
        exit_fail,
        exit_busy,
        exit_wait,
        exit_ready);
    response_type=set of response_type_set;

    tscope_network = class(tform)
        network_panel: TPanel;
        server_connect_group: TGroupBox;
        connect_to_server_button: TSpeedButton;
        disconnect_from_server_button: TSpeedButton;
        connected_light: TMaskEdit;
        server_ip_edit: TEdit;
        edit_port: TEdit;
        network_timer: TTimer;
        scope_client: TIdTCPClient;
    status_log: TMemo;
        clear_log_button: TBitBtn;
        messages_button: TBitBtn;
        disk_button: TBitBtn;

        { form functions }
        procedure formcreate(
            Sender:TObject);

        procedure kill;

        procedure form_close_query(
                    Sender: TObject;
            var CanClose: Boolean);

        { network controls }
        procedure connect_to_server;

        procedure close_network_connection;

        procedure connect_to_server_buttonClick(
            Sender: TObject);

        function send_message(
            message_string,
            error_string:string)
            :response_type;

        function send_request(
            message_str,
            error_str:string)
            :response_type;

        function send_request_check(
            message_string:string)
            :response_type;

        function get_option_value(
            option:string)
            :string;

        function get_float(
                    option:string;
            var exit_result:double)
            :boolean;

        function get_integer(
                    option:string;
            var exit_result:longint)
            :boolean;

        function get_string(
                    option:string;
            var exit_result:string)
            :boolean;

        function get_boolean(
                    option:string;
            var exit_result:boolean)
            :boolean;

        procedure network_timerTimer(
            Sender: TObject);

        procedure enable_network_timer(
            timeout_interval:longint);

        procedure disconnect_from_server_buttonClick(
            Sender: TObject);

        { network events }
        procedure update_model_type;

        { logging }
        procedure write_status_log(
            e:string;
            message_logging:boolean);

        procedure write_status_log_check(
            e:string);

        Procedure close_log;

        Procedure write_log(
            e:string);

        Procedure init_log_file(
            s:string);

        { configuration }
        procedure load_settings;
        procedure save_settings;

        { events }
        procedure FormShow(
            Sender: TObject);

        procedure adjust;

        procedure hide_form;
        procedure show_form;

        procedure check_activate(
            Sender: TObject);

        procedure disk_buttonClick(
            Sender: TObject);

        procedure messages_buttonClick(
            Sender: TObject);

        procedure clear_log_buttonClick(
            Sender: TObject);

    private
        { Private declarations }
        server_ip_address:string;
        received_text:widestring;
        network_connected,
        server_playing,
        network_timed_out:boolean;
        option_names,
        option_values:tstrings;
        indented:integer;
        { logging }
        log_handle:textfile;
        log_filename:string;
        last_line_indented,
        last_line_unindented:boolean;
    public
        { Public declarations }
        network_enabled,
        scope_connected:boolean;
        form_top,
        form_left:integer;
        { logging }
        logging:boolean;
        message_logging:boolean;
        { configuration }
        dimensions:dimensions_record;

        { methods }
        procedure check_visible_and_show_hide(
            sender:tobject);
    end;

var
    scope_network: tscope_network;

implementation

uses
    ntc_client_control,
    ntc_client_info;

{$R *.dfm}

    { ----------
        form stuff
        ---------- }

procedure tscope_network.formcreate(
    Sender:TObject);
begin
    network_timer.enabled:=false;
    { network defaults }
    network_connected:=false;
    server_playing:=false;
    option_names:=tstringlist.create;
    option_values:=tstringlist.create;
    scope_connected:=false;
    connect_to_server_button.enabled:=true;
    server_connect_group.enabled:=true;
    indented:=0;
    last_line_indented:=false;
    last_line_unindented:=false;
    load_settings;
    if logging then
        scope_network.init_log_file('ntc-client.log');
end;

procedure tscope_network.kill;
begin
    if network_enabled then
        begin
            if scope_connected then
                begin
                    send_request_check('disconnect');
                    scope_network.scope_connected:=false;
                    send_request_check('bored');
                end;
            close_network_connection;
        end;
    option_names.free;
    option_values.free;
end;

procedure Tscope_network.form_close_query(
            Sender: TObject;
    var CanClose: Boolean);
begin
    canclose:=false;
    visible:=false;
    with dimensions do
        begin
            form_top:=top;
            form_left:=left;
        end;
end;

    { -------------
        network stuff
        ------------- }

procedure tscope_network.connect_to_server;
var
    j,k:integer;
    e:string;
    f:boolean;
begin
    write_status_log_check('connect to server >>');
    e:='connected to server';
    f:=false;
    with scope_client do
        begin
            Port:=StrToint(edit_Port.Text);
            if port<1024 then
                begin
                    e:='I needs a port greater than 1024';
                    f:=true;
                end
            else
                begin
                    server_ip_address:=server_ip_edit.text;
                    host:=server_ip_address;
                    enable_network_timer(connect_timeout);
                    try
                        j:=0;
                        k:=1;
                        connect;
                        repeat
                            application.processmessages;
                            connected_light.color:=$00ff0000+j;
                            if Focused then
                                connected_light.show;
                            inc(j,k);
                            if j>255 then
                                k:=-1
                            else if j<0 then
                                k:=1;
                        until connected or network_timed_out;
                    except
                        on err:exception do
                            begin
                                e:='exception when trying to connect to server : '+err.message;
                                f:=true;
                            end;
                    end;
                    if network_timed_out then
                        begin
                            e:='network connection timed out';
                            f:=true;
                            network_timed_out:=false;
                        end
                    else
                        begin
                            network_enabled:=true;
                            if send_request('play','Server wont play')>=[exit_ok] then
                                begin
                                    connected_light.Color:=cllime;
                                    if Focused then
                                        connected_light.Show;
                                    connect_to_server_button.Enabled:=false;
                                    disconnect_from_server_button.enabled:=true;
                                    get_integer('model',k);
                                    scope_type:=k;
                                    update_model_type;
                                    scope_control.connect_group.enabled:=true;
                                end;
                        end;
                end;
        end;
    if f then
        begin
            connect_to_server_button.Enabled:=true;
            disconnect_from_server_button.enabled:=false;
            connected_light.Color:=clred;
            if Focused then
                connected_light.Show;
            write_status_log_check(e);
        end;
    write_status_log_check('<< connect to server');
end;

procedure tscope_network.close_network_connection;
begin
    if scope_connected then
        begin
            send_request_check('disconnect');
            scope_network.scope_connected:=false;
            send_request_check('bored');
        end;
    if scope_client.connected then
        scope_client.Disconnect;
    network_enabled:=false;
    connected_light.Color:=clred;
    if Focused then
        connected_light.Show;
    disconnect_from_server_button.enabled:=false;
    connect_to_server_button.enabled:=true;
    scope_control.change_panel(false);
    scope_control.connect_group.enabled:=false;
end;

function tscope_network.send_message(
    message_string,
    error_string:string)
    :response_type;
var
    e,s,t:string;
    done,
    failed:boolean;
    i:integer;

    function send
        :response_type;
    begin
        write_status_log_check('send : >>');
        result:=[exit_ok];
        e:='i said '+message_string;
        failed:=false;
        if scope_client.connected then
            begin
                message_string:=message_string;
                received_text:='';
                enable_network_timer(response_timeout);
                scope_client.writeln(message_string);
                repeat
                    try
                        application.processmessages;
                        received_text:=scope_client.readln(
                            crlf,read_fail_count,max_buffer_size);
                    except
                        on err:exception do
                            begin
                                e:=e+' : but failed with : '+err.message;
                                scope_connected:=false;
                                connect_to_server_button.Enabled:=true;
                                disconnect_from_server_button.enabled:=false;
                                connected_light.Color:=clred;
                                if Focused then
                                    connected_light.Show;
                                scope_client.disconnect;
                                failed:=true;
                            end;
                    end
                until network_timed_out or (received_text<>'') or failed;
                s:=trim(received_text);
                if network_timed_out or failed or (s='') then
                    begin
                        if network_timed_out then
                            begin
                                e:=e+' : but timed out : ';
                                failed:=true;
                                network_timed_out:=false;
                            end;
                    end
                else if s<>'' then
                    begin
                        if pos('ok',s)=1 then
                            begin
                                if pos('=',s)=3 then
                                    begin
                                        if pos('(',s)=4 then
                                            begin
                                                s:=copy(s,5,length(s));
                                                if s[length(s)]=')' then
                                                    begin
                                                        s[length(s)]:=',';
                                                        option_names.clear;
                                                        option_values.Clear;
                                                        done:=false;
                                                        while not done do
                                                            begin
                                                                i:=pos(',',s);
                                                                if i>0 then
                                                                    begin
                                                                        t:=copy(s,1,i-1);
                                                                        s:=copy(s,i+1,length(s));
                                                                        i:=pos('=',t);
                                                                        option_names.Add(copy(t,1,i-1));
                                                                        option_values.add(copy(t,i+1,length(t)));
                                                                    end
                                                                else
                                                                    done:=true;
                                                            end;
                                                    end
                                                else
                                                    begin
                                                        e:=e+' : but response incomplete : ';
                                                        failed:=true;
                                                    end;
                                            end
                                    end;
                            end
                        else if pos('fail',s)=1 then
                            begin
                                e:=e+' : but response incorrect : ';
                                failed:=true;
                            end
                    end
            end
        else
            begin
                e:=e+' : not connected, so reseting : ';
                connect_to_server_button.Enabled:=true;
                disconnect_from_server_button.enabled:=false;
                connected_light.Color:=clred;
                if Focused then
                    connected_light.Show;
                scope_client.disconnect;
                failed:=true;
            end;
        if failed then
            begin
                e:=e+' : '+error_string;
                with scope_control do
                    begin
                        ignore_event_north:=event_0;
                        ignore_event_south:=event_0;
                        ignore_event_west:=event_0;
                        ignore_event_east:=event_0;
                    end;
                result:=[exit_fail];
            end;
        write_status_log_check(e);
        write_status_log_check('<< : send');
    end;

begin
    result:=send;
end;

function tscope_network.send_request(
    message_str,
    error_str:string)
    :response_type;
begin
    result:=send_message(message_str,error_str);
end;

function tscope_network.send_request_check(
    message_string:string)
    :response_type;
begin
    result:=send_request(message_string,no_response);
end;

function tscope_network.get_option_value(
    option:string)
    :string;
var
    i:integer;
begin
    i:=option_names.indexof(option);
    if i>=0 then
        result:=option_values[i]
    else
        result:='';
end;

function tscope_network.get_float(
            option:string;
    var exit_result:double)
    :boolean;
var
    s:string;
begin
    s:=get_option_value(option);
    if s<>'' then
        begin
            exit_result:=strtofloat(s);
            result:=true;
        end
    else
        result:=false;
end;

function tscope_network.get_integer(
            option:string;
    var exit_result:longint)
    :boolean;
var
    s:string;
begin
    s:=get_option_value(option);
    if s<>'' then
        begin
            exit_result:=strtoint(s);
            result:=true;
        end
    else
        result:=false;
end;

function tscope_network.get_string(
            option:string;
    var exit_result:string)
    :boolean;
var
    s:string;
begin
    s:=get_option_value(option);
    if s<>'' then
        begin
            exit_result:=s;
            result:=true;
        end
    else
        result:=false;
end;

function tscope_network.get_boolean(
            option:string;
    var exit_result:boolean)
    :boolean;
var
    s:string;
begin
    s:=get_option_value(option);
    if s<>'' then
        begin
            exit_result:=s='true';
            result:=true;
        end
    else
        result:=false;
end;

procedure tscope_network.enable_network_timer(
    timeout_interval:longint);
begin
    with network_timer do
        begin
            enabled:=false;
            network_timed_out:=false;
            interval:=timeout_interval;
            enabled:=true;
        end;
end;

procedure tscope_network.network_timerTimer(
    Sender: TObject);
begin
    network_timer.enabled:=false;
    network_timed_out:=true;
end;

procedure tscope_network.update_model_type;
begin
    with scope_control do
        slew_group.visible:=true;
end;

    { -------
        logging
        ------- }

procedure tscope_network.write_status_log(
    e:string;
    message_logging:boolean);
var
    s:string;
    a,m:boolean;
begin
    if message_logging then
        begin
            a:=false;
            m:=false;
            if pos('>>',e)>0 then
                begin
                    if not last_line_indented then
                        inc(indented,2)
                    else
                        last_line_indented:=false;
                    a:=true;
                end
            else if pos('<<',e)>0 then
                begin
                    if not last_line_unindented then
                        dec(indented,2)
                    else
                        last_line_unindented:=false;
                    m:=true;
                end;
            s:=stringofchar(#32,indented)+e;
            if a then
                begin
                    inc(indented,2);
                end
            else if m then
                begin
                    dec(indented,2);
                end;
            status_log.Lines.Add(s+#13);
            scope_network.write_log(s);
        end;
end;

procedure tscope_network.write_status_log_check(
    e:string);
begin
    if message_logging then
        write_status_log(e,true);
end;

Procedure tscope_network.init_log_file(
    s:string);
var
    io:integer;
begin
    try
        log_filename:=application_path+s;
        {$I-}
        assignfile(log_handle,log_filename);
        {$I+}
        io:=ioresult;
        if io=0 then
            begin
                rewrite(log_handle);
                writeln(log_handle,DateTimeToStr(now)+' : session started');
                close_log;
            end
        else
            write_status_log_check('cant create log file : '+log_filename);
    except
        on err:exception do
            begin
                write_status_log_check('failed to open log : '+err.message);
            end;
    end;
end;

Procedure tscope_network.write_log(
    e:string);
var
    io:integer;
begin
    if logging then
        begin
            try
                {$I-}
                assignfile(log_handle,log_filename);
                {$I+}
                io:=ioresult;
                if io=0 then
                    begin
                        append(log_handle);
                        writeln(log_handle,FormatDateTime('hh:mm:ss.zzz',now)+' : '+e);
                        close_log;
                    end
                else
                    write_status_log_check('cant open log : '+log_filename);
            except
                on err:exception do
                    begin
                        write_status_log_check('failed to write to log : '+err.message);
                        close_log;
                    end
            end;
        end;
end;

Procedure tscope_network.close_log;
var
    io:integer;
begin
    try
        {$I-}
        closefile(log_handle);
        {$I+}
        io:=ioresult;
        if io<>0 then
             write_status_log_check(
            'failed to close : '+log_filename+' : '+inttostr(io));
    except
        on err:exception do
            write_status_log_check('failed to close log : '+err.message);
    end;
end;

    { -------------
        configuration
        ------------- }

procedure tscope_network.load_settings;
begin
    ini_file:=tinifile.create(application_path+'client.ini');
    with ini_file do
        begin
            server_ip_address:=ReadString('network','ip_address','127.0.0.1');
            server_ip_edit.text:=server_ip_address;
            logging:=ReadBool('network','logging',false);
            if logging then
                disk_button.Font.style:=[fsbold]
            else
                disk_button.font.style:=[];
            message_logging:=ReadBool('network','message_logging',true);
            if message_logging then
                messages_button.Font.style:=[fsbold]
            else
                messages_button.font.style:=[];
            { form }
            scope.get_dimensions(scope_network,@dimensions,'network',ini_file);
            left:=dimensions.form_left;
            top:=dimensions.form_top;
            visible:=readbool('network','visible',false);
        end;
    ini_file.free;
end;

procedure tscope_network.save_settings;
begin
    with ini_file do
        begin
            writestring('network','ip_address',server_ip_address);
            writebool('network','logging',logging);
            writebool('network','message_logging',message_logging);
            { form }
            scope.find_vdu(scope_network,@dimensions);
            scope.write_dimensions(@dimensions,left,top,'network',ini_file);
            writebool('network','visible',visible);
        end;
end;

    { ------
        events
        ------ }

procedure tscope_network.FormShow(
    Sender: TObject);
begin
    with dimensions do
        begin
            top:=form_top;
            left:=form_left;
        end;
end;

procedure tscope_network.adjust;
begin
    with dimensions do
        begin
            form_top:=trunc(form_top/last_screen_height*current_height);
            form_left:=trunc(form_left/last_screen_width*current_width);
        end;
    if visible then
        show;
end;

procedure tscope_network.check_visible_and_show_hide(
    sender:tobject);
begin
    if visible then
        hide_form
    else
        show_form;
    scope.show_hide(sender,visible);
end;

procedure tscope_network.hide_form;
begin
    with dimensions do
        begin
            form_top:=top;
            form_left:=left;
        end;
    Visible:=false;
end;

procedure tscope_network.show_form;
begin
    Visible:=true;
end;

procedure Tscope_network.check_activate(
    Sender: TObject);
begin
    scope.form_activate(scope_network,@dimensions);
end;

procedure tscope_network.connect_to_server_buttonClick(
    Sender: TObject);
begin
    connect_to_server;
end;

procedure tscope_network.disconnect_from_server_buttonClick(
    Sender: TObject);
begin
    if scope_client.connected then
        begin
            if scope_connected then
                scope_control.disconnect_from_scope;
            send_request('bored','server wont go');
        end;
    close_network_connection;
end;

procedure tscope_network.clear_log_buttonClick(
    Sender: TObject);
begin
    status_log.Lines.Clear;
    write_status_log_check('log cleared');
end;

procedure tscope_network.messages_buttonClick(
    Sender: TObject);
begin
    if not message_logging then
        begin
            message_logging:=true;
            messages_button.font.style:=[fsbold];
            write_status_log_check('messages enabled');
        end
    else
        begin
            messages_button.font.style:=[];
            write_status_log_check('messages disabled');
            message_logging:=false;
        end;
end;

procedure tscope_network.disk_buttonClick(
    Sender: TObject);
begin
    with scope_network do
        begin
            if logging then
                begin
                    logging:=false;
                    disk_button.font.style:=[];
                    write_status_log_check('logging disabled');
                end
            else
                begin
                    logging:=true;
                    init_log_file('ntc-client.log');
                    disk_button.font.style:=[fsbold];
                    write_status_log_check('logging enabled');
                end;
        end;
end;

end.